{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 18.12.2008 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit JabberHelper;

interface

uses
  Presence, Roster, XMLTag,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, debugwin,
  Dialogs, StdCtrls, ExtCtrls,NodeItem,chatcontroller,jabberconst,jabbermsg,typinfo,unicode,XMLParser,Entity,JabberID{,EntityCache},stringprep,dnsutils,
  IdBaseComponent, IdComponent, IdDNSResolver1, JabberSession, InetCommunication, PrefController, Avatar;

const
  sAuthNoAccount = 'This account does not exist on this server. Create a new account?';

type
  TJabberAction = (jaNone, jaCreateUser, jaRemoveUser, jaGetProfile, jaSaveProfile);
  TJabberNewUserState = (juNone, juProgress, juOK, juAlreadyExists, juLoginError, juError);

type
  TJabberHelper = class(TInetCom)
  private
    FAppClosing: Boolean;
    _JabberAction: TJabberAction;
    _jabberCreateNewUserState: TJabberNewUserState;
    _debugFrm: TFrmDebug;
    _logoff: Boolean;
    _doingLogin: Boolean;
    _loginState: string;
    _LoginError: Boolean;
    _connected: Boolean;
    _gettingAllContacts: Boolean;
    _new_account: Boolean;              // is this a new account
    _dns_cb: Integer;
    _cleanupComplete: Boolean;        //all close events have fired and app is ready to terminate
      // Reconnect variables
    //_reconnect_interval: Integer;
    //_reconnect_cur: Integer;
    _reconnect_tries: Integer;
    _shutdown: Boolean;                 // are we being shutdown
    _dcb: Integer;
    _scb: Integer;
    _rcb: Integer;
    _pcb: Integer;

    MainSession: TJabberSession;
    procedure DoConnect();
    procedure DNSCallback(event: string; tag: TXMLTag);
    procedure cleanup();
    procedure CloseQuery(var CanClose: Boolean);
    procedure DebugCallback(event: string; Tag: TXMLTag; Data: WideString);
    procedure SessionCallback(event: string; Tag: TXMLTag);
    procedure RosterCallback(event: string; Tag: TXMLTag; roster_item: TJabberRosterItem);
    procedure PresenceCallback(event: string; Tag: TXMLTag; p: TJabberPres);
  public
    pref: TPrefController;
  public
    IdDNSResolver: TIdDNSResolver;
    JabberUserProfile: TUserProfile;
    constructor Create();
    destructor Destroy(); override;
    function IsAppclosing(): Boolean;
    function IsLoginError(): Boolean;
    function IsConnected(): Boolean;
    function GetLoginState(): string;
    procedure SetDebugFrm(dbgFrm: TFrmDebug);
    procedure Disconnect();
    procedure CancelConnect();
    procedure QueryEndSession(var msg: TMessage);
    function RegisterNewUserStatus(var status: string): TJabberNewUserState;
    procedure RemoveJabberUser(jid, Password, server: string);
    procedure RegisterNewJabberUser(ProfileName, jid, Password, Server: string);
    function RemoveAccountStatus(var status: string): TJabberNewUserState;
  end;

function ReparseTag(oldTag: TXMLTag): TXMLTag;
procedure CloseAllChats();

implementation

uses
  StandardAuth;

procedure CloseAllChats();
var
  i: integer;
begin
  with MainSession.ChatList do
  begin
    for i := Count - 1 downto 0 do
    begin
      Delete(i);
    end;
  end;
end;

constructor TJabberHelper.Create();
var
  auth: TStandardAuth;
begin
  // Create some the main session and associated objects
  inherited Create(nil);
  _loginState := '';
  _jabberCreateNewUserState := juNone;
  _debugFrm := nil;
  IdDNSResolver := TIdDNSResolver.create(nil);
  _gettingAllContacts := False;
  _doingLogin := False;
  with IdDNSResolver do
  begin
    Port := 53;
    QueryRecords := [];
  end;
  _connected := False;
  _reconnect_tries := 0;
  MainSession := TJabberSession.Create(ExtractFilePath(Application.ExeName) + 'jopl-default.xml', False);
  auth := TStandardAuth.Create(MainSession);
  MainSession.setAuthAgent(auth);
  MainSession.Prefs.LoadProfiles();
  pref := MainSession.Prefs;
  _dcb := MainSession.RegisterCallback(DebugCallback);
  _scb := MainSession.RegisterCallback(SessionCallback, '/session');
  _rcb := MainSession.RegisterCallback(RosterCallback, '/roster');
  _pcb := MainSession.RegisterCallback(PresenceCallback);
  _LoginError := false;
  FAppClosing := False;
  _logoff := False;
  _cleanupComplete := False;
  _shutdown := False;
  _JabberAction := jaNone;
  JabberUserProfile := TUserProfile.create(MainSession);
end;

destructor TJabberHelper.Destroy();
begin
  if (not _cleanupComplete) then
    Cleanup()
  else
  begin
    JabberUserProfile.Free();
    IdDNSResolver.Free();
    MainSession.Destroy();
    inherited Destroy();
  end;
end;

procedure TJabberHelper.RegisterNewJabberUser(ProfileName, jid, Password, Server: string);
begin
  _JabberAction := jaCreateUser;
  _jabberCreateNewUserState := juProgress;
  MainSession.Prefs.CreateProfile(ProfileName);
  MainSession.ActivateProfile(0);
  MainSession.Server := Server;
  MainSession.password := Password;
  MainSession.Username := jid;
  MainSession.Profile.NewAccount := True;
  DoConnect();
end;

procedure TJabberHelper.RemoveJabberUser(jid, Password, server: string);
begin
  _JabberAction := jaRemoveUser;
  _jabberCreateNewUserState := juProgress;
  if not(Assigned(MainSession.Profile)) then
  begin
    MainSession.Prefs.CreateProfile('Default Profile');
    MainSession.ActivateProfile(0);
    MainSession.Server := server;
    MainSession.Username := jid;
  end;
  MainSession.Password := Password;
  DoConnect;
end;

procedure TJabberHelper.DebugCallback(event: string; tag: TXMLTag; data: WideString);
begin
  // we are getting something from the socket
  if Assigned(_debugFrm) then
  begin
    if (event = '/data/send') then
      _debugFrm.NewString(data, True)
    else
      _debugFrm.NewString(data, False);
   end;
end;

procedure TJabberHelper.DoConnect();
var
  rip: string;
  req_srv: string;
  req_a: string;
begin
  // Make sure that the active profile
  // has the password field filled out.
  // If not, pop up the password prompt,
  // otherwise, just call connect.

  // NB: For non-std auth agents, set prompt_password
  // accordingly.
  //make sure we have an auth agent

  MainSession.Prefs.setString('temp-pw', MainSession.Password);
  MainSession.FireEvent('/session/connecting', nil);
  if Assigned(_debugFrm) then
    _debugFrm.Clear;
  with MainSession.Profile do
  begin
    // These are fall-thru defaults..
    if (Host <> '') then
      ResolvedIP := Host
    else
      ResolvedIP := Server;
    ResolvedPort := Port;
    // If we should, do SRV lookups
    if (srv) then
    begin
      _dns_cb := MainSession.RegisterCallback(DNSCallback, '/session/dns');
      req_srv := '_xmpp-client._tcp.' + Server;
      req_a := Server;
      rip := '';
      // DebugMsg('Looking up SRV: ' + req_srv);
      GetSRVAsync(MainSession, IdDNSResolver, req_srv, req_a);
    end
    else
    begin
      // DebugMsg('Using specified Host/Port: ' + Host + '  ' + IntToStr(Port));
      MainSession.Connect();
    end;
  end;
end;

procedure TJabberHelper.DNSCallback(event: string; tag: TXMLTag);
var
  t: string;
  ip: string;
  p: Word;
begin
  // process the async DNS request
  MainSession.UnRegisterCallback(_dns_cb);
  _dns_cb := -1;
  t := tag.getAttribute('type');
  if (t = 'failed') then with MainSession.Profile do
  begin
    // stringprep here for idn's
    ResolvedIP := xmpp_nameprep(Server);
    if (ssl = ssl_port) then
        ResolvedPort := 5223
    else
        ResolvedPort := 5222;
    //DebugMsg('Direct DNS failed.. Using server: ' + Server);
    MainSession.Connect();
    Exit;
  end;

  // get the bits off the packet
  ip := Trim(tag.getAttribute('ip'));
  p := StrToIntDef(tag.getAttribute('port'), 0);

  with MainSession.Profile do
  begin
    if (ip <> '') then
        ResolvedIP := ip
    else
        ResolvedIP := Server;
    if (p > 0) then
        ResolvedPort := p
    else
        ResolvedPort := 5222;

    if ((ResolvedPort = 5222) and (ssl = ssl_port)) then
        ResolvedPort := 5223;

  {  if (p > 0) then
        DebugMsg('Got SRV: ' + ResolvedIP + '  ' + IntToStr(ResolvedPort))
    else
        DebugMsg('Got A: ' + ResolvedIP + '  ' + IntToStr(ResolvedPort));   }
  end;

  if (not MainSession.Active) then MainSession.Connect();
end;

procedure TJabberHelper.CancelConnect();
begin
  _logoff := true;

  // we don't care about DNS lookups anymore
  if (_dns_cb <> -1) then
  begin
    MainSession.UnRegisterCallback(_dns_cb);
    _dns_cb := -1;
    CancelDNS();
    MainSession.FireEvent('/session/disconnected', nil);
  end
  else if (MainSession.Active) then
    Disconnect()
end;

procedure TJabberHelper.cleanup();
begin
  CloseAllChats();
  _cleanupComplete := true;
end;

procedure TJabberHelper.SessionCallback(event: string; tag: TXMLTag);
var
  t: TXMLTag;
begin
  if event = '/session/server_prefs' then
  begin
    _gettingAllContacts := false;
  end
  //else if event = '/session/presence' then begin end
  else if event = '/session/connecting' then
  begin
    _doingLogin := true;
    _LoginError := false;
    _gettingAllContacts := true;
    _loginState := 'Connecting..';
    _connected := false;
  end
  else if event = '/session/connected' then
  begin
    _loginState := 'Authenticating..';
    _logoff := false;
    _reconnect_tries := 0;
    _connected := true;
  end
  // We are getting some kind of session event
  else if (event = '/session/authenticated') then
  begin
    _connected := true;
    _doingLogin := false;
    if _JabberAction = jaCreateUser then
    begin
      _jabberCreateNewUserState := juOK;
      Disconnect;
    end
    else if _jabberAction = jaRemoveUser then
    begin
      MainSession.RemoveAccount();
      _loginState := 'Removing account..';
    end;
  end
  //else if (event = '/session/gui/contact') then begin end
  //else if (event = '/session/gui/chat') then begin end
  //else if (event = '/session/error/noaccount') then begin end
  else if (event = '/session/error/reg') then
  begin
    if _connected then
    begin
      _doingLogin := false;
      _LoginError := true;
      t := tag.GetFirstTag('error');
      _loginState := t.ChildTags[0].Name+' '+t.GetAttribute('type')+' ('+t.GetAttribute('code')+ ')';
      if _JabberAction = jaCreateUser then
      begin
        _jabberCreateNewUserState := juAlreadyExists;
      end
      else if _JabberAction = jaRemoveUser then
      begin
        _jabberCreateNewUserState := juLoginError;
      end;
      CancelConnect;
      disconnect;
    end;
  end
  else if (event = '/session/error/auth') then
  begin
    _doingLogin := false;
    _LoginError := true;
    t := tag.GetFirstTag('error');
    _loginState := t.ChildTags[0].Name+' '+ t.GetAttribute('type')+' ('+t.GetAttribute('code')+ ')';
    if _JabberAction = jaCreateUser then
    begin
      _jabberCreateNewUserState := juAlreadyExists;
    end
    else if _JabberAction = jaRemoveUser then
    begin
      _jabberCreateNewUserState := juLoginError;
    end;
    CancelConnect;
    disconnect;
  end
  else if (event = '/session/error/remove') then
  begin
    disconnect;
    if _JabberAction = jaRemoveUser then
    begin
      _jabberCreateNewUserState := juError;
    end;
  end
  else if (event = '/session/removeok') then
  begin
    disconnect;
    if _JabberAction = jaRemoveUser then
    begin
      _jabberCreateNewUserState := juOK;
    end;
  end
  else if (event = '/session/disconnected') then
  begin
    if _JabberAction = jaCreateUser then
    begin
      if _jabberCreateNewUserState = juProgress then
        _jabberCreateNewUserState := juError;
    end;
    _doingLogin := false;
    _connected := false;
    _new_account := false;
  end;
end;

procedure TJabberHelper.RosterCallback(event: string; tag: TXMLTag; roster_item: TJabberRosterItem);
begin
  // we are getting some kind of roster item
  // store a reference to the roster item in the listbox's item
  // this way, we can find them.
  if (event = '/roster/start') then begin
      _loginState := 'Getting Contacts..';
       exit;
  end;
  if (event = '/roster/end') then begin
        _loginState := '';
       exit;
  end;
  if ((event = '/roster/item') and (roster_item <> nil)) then begin
  end;
end;

procedure TJabberHelper.PresenceCallback(event: string; tag: TXMLTag; p: TJabberPres);
begin
  if (tag = nil) then exit;
  //if event = '/presence/online' then begin end
  //else if event = '/presence/available' then begin end;
end;

function ReparseTag(oldTag: TXMLTag): TXMLTag;
var
  _parser: TXMLTagParser;
begin
  Result := nil;
  _parser := TXMLTagParser.Create();
  _parser.Clear();
  _parser.ParseString(oldTag.XML, '');
  if (_parser.Count > 0) then
      Result := _parser.popTag();
  _parser.Free();
end;

procedure TJabberHelper.CloseQuery(var CanClose: Boolean);
begin
  //mainsession should never be nil here, it is created before this object
  //and destroyed in ExSession finalization

  // If we are not already disconnected, then
  // disconnect. Once we successfully disconnect,
  // we'll close the form properly (xref _appclosing)
  if (MainSession.Active) and not(FAppClosing) then
  begin
    FAppClosing := True;
    _logoff := true;
    //  TAutoOpenEventManager.onAutoOpenEvent('disconnected');
    Disconnect();
    CanClose := false;
  end
  else
    Cleanup();
end;

procedure TJabberHelper.QueryEndSession(var msg: TMessage);
var
  a: Boolean;
begin
  _shutdown := True;
  a := true;
  CloseQuery(a);
  //waitForCleanup();
  if a then
    msg.Result := 1
  else
    msg.Result := 0;
end;

procedure TJabberHelper.Disconnect;
begin
  _connected:= false;
  MainSession.Disconnect;
end;

function TJabberHelper.IsConnected: boolean;
begin
  Result := _connected;
end;

function TJabberHelper.GetLoginState: string;
begin
  Result := _loginState;
end;

function TJabberHelper.IsLoginError: Boolean;
begin
  result := _LoginError;
end;

procedure TJabberHelper.SetDebugFrm(dbgFrm:TFrmDebug);
begin
  _debugFrm := dbgFrm;
end;

function TJabberHelper.IsAppClosing(): Boolean;
begin
  Result := FAppClosing;
end;

function TJabberHelper.RegisterNewUserStatus(var status: string): TJabberNewUserState;
begin
  result := _jabberCreateNewUserState;
  case _jabberCreateNewUserState of
    juNone:status := '';
    juProgress:status := 'Creating Account..';
    juOK:status := 'Account Registered';
    juAlreadyExists: status := 'Account already exists';
    juError:status := 'Error';
  end;
end;

function TJabberHelper.RemoveAccountStatus(var status: string): TJabberNewUserState;
begin
  result := _jabberCreateNewUserState;
  case _jabberCreateNewUserState of
    juNone:status := '';
    juProgress:status := 'Removing Account..';
    juOK:status := 'Account removed';
    juLoginError: status := 'Wrong password';
    juError:status := 'Error';
  end;
end;

end.



